home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
PPTSR10
/
TSR3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-12
|
21KB
|
838 lines
(*
* Functions for TSR programming.
* Inspired by article published in german magazine "DOS International"
* june 1992 by Reiner Wahler
*
* any questions, bugs, additions, remarks,...
* can be sent by e-mail to "pp@win.tue.nl"
*
* To create the object module tsr3.obj from tsr3.asm, extract trs3.asm
* from this source and assemble it using : "tasm tsr3.asm"
* To activate the debugging info in the assembly part assemble
* tsr3.asm using : "tasm /ddebug tsr3.asm"
* To activate the debugging info in the pascal part change the
* "undef debug" below into "define debug"
*)
{$undef debug}
(*
;;Program : tsr3.asm
;;Function : Routines for TSR programs
;;Language : Tasm 2.0
;;From : DOS International, June 1992
;;Modified : by P.Peters June 1992 (pp@win.tue.nl)
;; modified so it worked....
;; added check of indos and idle flag and
;; debugging code.
;; changed some names to be more meaningfull.
;
;data segment word public
;
; extrn TurboSS : word ;stack segment
; extrn TurboSP : word ;stack pointer
; extrn DosVars : dword ;os variable area
; extrn OldInts : dword ;old vectors
; extrn NewInts : dword ;Catch routines
; extrn PrefixSeg : word ;prefix segment
; extrn Int2fId : byte ;program id
; extrn User2FServer : dword ;User 2F interface
; extrn ExeName : byte ;for test if already installed
;
;data ends
;
;code segment byte public
;
; extrn TurboFrame : near
; public SetUp
; public Dummy1B
;
; assume cs:code,ds:data
;
;;
;; offsets of new vectors. take care to use the same order as in
;; pascal counterpart
;;
;SerVer dw offset Server08
; dw offset Server09
; dw offset Catch10
; dw offset Catch13
; dw offset Catch16
; dw offset Catch25
; dw offset Catch26
; dw offset Server28
; dw offset Catch2a
; dw offset Server2f
;
;;
;; addresses of original vectors
;; must be in the same order as in the pascal counterpart as well
;;
;Int08 dd ?
;Int09 dd ?
;Int10 dd ?
;Int13 dd ?
;Int16 dd ?
;Int25 dd ?
;Int26 dd ?
;Int28 dd ?
;Int2a dd ?
;Int2f dd ?
;
;;
;; stack of interrupted program
;;
;SSsave dw ?
;SPSave dw ?
;
;;
;;address of Indos flag
;;
;InDosAdr dd ?
;
;IFDEF debug
;;
;;Here is an extra routine to do updates on flags normally
;;not displayed.
;;
;Show proc near
; push ax
; push es
; push di
; les di,[DosVars]
; mov ax,es:[di]
; mov cs:[exterr],ax
; les di,[InDosAdr]
; mov ah,es:[di]
; mov cs:[indos],ah
; pop di
; pop es
; pop ax
; ret
;Show endp
;;
;;add an easy to find marker to check the tsr flags
;;I use "xraymon" (a tsr memory monitor) to do that....
;;
; db 'flag: indos(1) extended error(2) request(1)'
; db ' active(1) bioscrit(1) doscrit(1) idle(1)'
;indos db 0
;exterr dw 0
;
;ENDIF
;
;;
;; flags
;;
;request db 0 ;activation requested ?
;active db 0 ;already active ?
;bioscrit db 0 ;bios critical ints active ?
;doscrit db 0 ;set by int2a (dos critical region)
;idle db 0 ;set by int28
;
;;
;;copies of datasegment variables
;;
;id db ? ;id for int 2fh
;hotkey dw ? ;activation keyboard code
;
;Activate proc near
;;
;;activation routine
;;started by Server08 or by DOS via Server28
;;
; pushf
; cmp word ptr [request],1 ;is it requested and not active
; jne noact ;nope
; cmp word ptr [bioscrit],0 ;check bioscrit and doscrit
; ;in one check
; jne noact ;not safe !
; mov [active],1 ;indicate activity
; push ax ;save registers
; push ds
; mov ax,data ;set data segment
; mov ds,ax
; mov SSSave,ss ;save stack ptr and seg
; mov SPSave,sp
; mov ss,TurboSS ;set turbo stack
; mov sp,TurboSP
; push bx ;save registers
; push cx
; push dx
; push di
; push si
; push es
; cmp [idle],1
; je idleact
; les di,[InDosAdr]
; mov ah,es:[di]
; cmp ah,0
; jne crit
; les di,[DosVars]
; mov ax,es:[di]
; cmp ax,0
; jne crit
;idleact:
; sti ;enable int's
; call TurboFrame
; cli ;don't disturb
; mov [request],0
;crit:
; pop es ;restore registers
; pop si
; pop di
; pop dx
; pop cx
; pop bx
; mov ss,SSSave
; mov sp,SPSave
; pop ds
; pop ax
; mov [active],0
;noact:
; popf
; ret
;Activate endp
;
;Server08 proc far
;;
;;Int 08h clock tick
;;
; pushf
; call [Int08]
;IFDEF debug
; call Show ;copy indos and
; ; extended error flags
;ENDIF
; call Activate
; iret
;Server08 endp
;
;Server09 proc far
;;
;;Int 09h keyboard
;;check for hotkey and setup for activation if hotkey detected
;;
; pushf
; call [Int09]
; push ax
; push bx
; push es
; mov ax,40h ;bios data seg
; mov es,ax
; mov bx,es:[1ch] ;kbd buffer
; dec bx
; dec bx
; cmp bx,1eh ;check if at end
; jge NoLow
; mov bx,3ch
;Nolow:
; mov ax,es:[bx]
; cmp ax,[HotKey] ;is this our hotkey ?
; jne NoKey ;no, all trouble was no use
; mov es:[1ch],bx
; cmp [active],0 ;tsr already active ?
; jne NoKey ;yes, do not request again!
; mov [request],1 ;request activation
;NoKey:
; pop es
; pop bx
; pop ax
; iret
;Server09 endp
;
;;
;;Catch routines for critical bios interrupts
;;
;
;Catch10 proc far
;;
;;Int 10h Video
;;
; pushf
; inc [bioscrit]
; call [Int10]
; pushf
; dec [bioscrit]
; popf
; iret
;Catch10 endp
;
;Catch13 proc far
;;
;;Int 13h Harddisk
;;
; pushf
; inc [bioscrit]
; call [Int13]
; pushf
; dec [bioscrit]
; popf
; retf 2
;Catch13 endp
;
;Catch16 proc far
;;
;;Int 16h Keyboard
;;
; pushf
; inc [bioscrit]
; call [Int16]
; push ax
; pushf
; pop ax
; push bp
; mov bp,sp
; mov [bp+8],ax
; pop bp
; pop ax
; pushf
; dec [bioscrit]
; popf
; iret
;Catch16 endp
;
;Catch25 proc far
;;
;;Int 25h Abs disk read
;;
; inc [bioscrit]
; call [Int25]
; pushf
; dec [bioscrit]
; popf
; retf
;Catch25 endp
;
;Catch26 proc far
;;
;;Int 26h Abs disk write
;;
; inc [bioscrit]
; call [Int26]
; pushf
; dec [bioscrit]
; popf
; retf
;Catch26 endp
;
;Server28 proc far
;;
;;Int 28h is used by dos when keyboard input is
;;requested (Idle loop)
;;
; pushf
; inc [idle]
; pushf
; call [Int28]
; call Activate
; dec [idle]
; popf
; iret
;Server28 endp
;
;;
;;Catch routines for dos interrupts
;;
;
;Catch2a proc far
;;
;;Int 2ah Critical phase
;;
; pushf
; cmp ah,80h ;start crit section ?
; je act ;yes
; cmp ah,81h ;end crit section
; je deact ;yes
; cmp ah,87h ;start/end crit section ?
; jne ok ;no
; cmp al,0 ;start ?
; je act ;yes
; cmp al,1 ;end ?
; jne ok ;no
;deact: ;end crit section
; inc [doscrit]
; jmp ok
;act: ;start crit section
; dec [doscrit]
;ok:
; popf
; jmp [Int2a]
;Catch2a endp
;
;Server2f proc far
;;
;;called by int2f to perform program id dependant functions
;;ah = id
;;al = 0 - return pointer to executable name
;; 1 - return vectors for de-installation
;; 2+ - user functions (via 'Server' procedure of TsrInstall)
;;
; pushf
; cmp ah,id ;is this our id ?
; je send
; popf
; jmp [Int2f] ;no, so continue elsewhere
;send: ;check function
; popf
; push ds
; push bx
; mov bx,data
; mov ds,bx
; cmp al,0 ;already installed ?
; jne tst1
; mov es,bx
; mov di,offset [ExeName]
; xchg al,ah
; pop bx
; pop ds
; iret
;tst1:
; pop bx
; cmp al,1 ;vectors for de-installation ?
; jne user2f
; mov ax,cs
; mov es,ax
; mov bx,offset Server
; mov di,offset Int08
; mov dx,PrefixSeg
; pop ds
; iret
;user2f:
; sub ah,ah
; call User2FServer
; pop ds
; iret
;Server2f endp
;
;SetUp proc near ;SetUp(Key:Word)
;;
;;Setup takes care of accessing variables in the code
;;segment of this object module
;;
; pop bx ;return address
; pop ax ;parameter "key"
; mov HotKey,ax
; mov al,Int2fId
; mov id,al
; push bx
; push es
; push ds
; mov ah,34h ;get InDos flag address
; int 21h
; pop ds
; mov word ptr [InDosAdr],bx
; mov word ptr [InDosAdr+2],es
; pop es
; pop bx
; ;now let OldInts^ and NewInts^ from the pascal part
; ;point to the corresponding data in the code
; ;segment of this object module
; mov word ptr [OldInts],offset Int08
; mov word ptr [OldInts+2],cs
; mov word ptr [NewInts],offset Server
; mov word ptr [NewInts+2],cs
; jmp bx
;SetUp endp
;
;Dummy1b proc far
;;
;;dummy ctrl-break handler
;;is active while tsr is active because a ctrl-break
;;would be fatal otherwise...
;;
; iret
;Dummy1b endp
;
;code ends
;end
;;
;; end of tsr3.asm
;;
*)
(*
* here is where the actual pascal module starts
*)
Unit tsr3;
{$S-,R-,A-,I-}
(* no stack- and rangecheck,
* no word alignment,
* no io-check
*)
Interface
Uses
Dos;
{$ifdef debug}
Uses
TpHex;
{$endif}
Type
TsrProc = Procedure;
Procedure UserDummy;
Procedure TsrInstall( KeyName : String; (* hotkey name *)
KeyCode : Word; (* hotkey scancode *)
TsrId : Byte; (* unique id for int2f *)
Proc : TsrProc; (* user hook *)
Server : TsrProc; (* Int2f receiver *)
Check : TsrProc ); (* Int2f sender *)
Const
Error : Integer = 0;
Var
HotKey : Word; (* keycode for activation *)
TsrLoaded : Boolean;
Implementation
Const
IntCnt = 10; (* replace 10 interrupts *)
Type
IntList = Array[1..IntCnt] Of Pointer; (* original vectors *)
OfsList = Array[1..IntCnt] Of Word; (* offset of our vectors *)
Const
IntNum : Array[1..IntCnt] Of Byte = (* int # to be replaced *)
($08, $09, $10, $13, $16, $25, $26, $28, $2a, $2f);
Var
UserProc : TsrProc; (* user hook *)
User2fServer : TsrProc;
(*
* OldInts and NewInts are filled by SetUp with adresses in CS
*)
OldInts : ^IntList; (* old vectors *)
NewInts : ^OfsList; (* new vectors *)
Int2fId : Byte; (* unique id for int2f *)
TurboSS : Word; (* turbo stack segment *)
TurboSP : Word; (* turbo stack pointer *)
ExeName : String[8]; (* programname for identification and messages *)
DosBufSize : Word;
DOSVars, (* Dos variables location *)
DOSBuffer : Pointer; (* Buffer to save the dos variables *)
TurboInt24 : Pointer; (* Turbo critical error handler *)
{$L tsr3.obj}
Procedure SetUp( key : Word ); Near; External;
Procedure Dummy1B; Far; External;
(*
* dos help functions
*)
Procedure SetPSP; Assembler;
Asm
mov ah,50h
mov bx,PrefixSeg
int 21h
End;
(*
* TurboFrame is called by int08h or int28h after the user pressed
* the hotkey
*)
Procedure TurboFrame; near;
{$ifdef debug}
Type
ar = array[1..100] of byte;
arptr = ^ar;
{$endif}
Var
i : byte;
ActInt09, ActInt16,
ActInt1b, ActInt24 : Pointer;
Begin
(*
* swap active keyboard interrupts with our own
*)
GetIntVec( $09, ActInt09 );
GetIntVec( $16, ActInt16 );
SetIntVec( $09, OldInts^[2] );
SetIntVec( $16, OldInts^[5] );
(*
* disable ctrl-break
*)
GetIntVec( $1b, ActInt1b );
SetIntVec( $1b, @Dummy1B );
(*
* critical error
*)
GetIntVec( $24, ActInt24 );
SetIntVec( $24, TurboInt24 );
(*
* move dos variables
*)
Move( DOSVars^, DOSBuffer^, DosBufSize );
{$ifdef debug}
for i := 1 to dosbufsize do write(hexbyte(arptr(dosbuffer)^[i]));
writeln;
{$endif}
(*
* setup PSP of TSR
*)
SetPSP;
(*
* This is why all this is done
*)
UserProc;
(*
* restore old situation
*)
Move( DOSBuffer^, DOSVars^, DosBufSize );
SetIntVec( $09, ActInt09 );
SetIntVec( $16, ActInt16 );
SetIntVec( $1b, ActInt1b );
SetIntVec( $24, ActInt24 );
End;
Procedure TsrInstall( KeyName : String;
KeyCode : Word;
TsrId : Byte;
Proc : TsrProc;
Server : TsrProc;
Check : TsrProc );
Var
i : Byte;
ProgSegs : Word;
CmdLn : String;
p : Pointer;
Procedure FreeMemBlock( BlockSeg : Word ); assembler;
(*
* function 49h
*)
Label
fin;
Asm
mov ah,49h { free allocated memory }
mov es,BlockSeg { block segment }
int 21h { dos interrupt }
jc fin { carry indicates error }
sub ax,ax
fin:
mov Error,ax
End;
Function DosVersion : Word; Assembler;
Asm
mov ax,3000h
int 21h
End;
Function GetDosVars : Boolean; Assembler;
Label
ok,fin;
Asm
push ds
mov ax,5d06h (* get dos swappable data area in ds:si *)
int 21h
jnc ok
xor ax,ax
pop ds
jmp fin
ok:
mov ax,ds
pop ds
mov word ptr [DOSVars],si
mov word ptr [DOSVars+2],ax
mov DosBufSize,dx (* cx = total, dx = head *)
mov al,1
fin:
End;
Procedure GetExeName;
Var
i : Byte;
s : String;
Begin
s := ParamStr(0);
i := Length(s);
While (s[i] <> '\') And (s[i] <> ':') And (i > 0) Do
Dec(i);
Exename := Copy(s,i+1,Length(s)-(i+4));
End;
(*
* TsrInstalled checks via int2fh if program is installed
*)
Function TsrInstalled : Boolean;
Var
nseg, noff : Word;
id : Byte;
Begin
Asm
mov ah,Int2fId
sub al,al
int 2fh
mov nseg,es
mov noff,di
mov id,al
End;
TsrInstalled := (string(ptr(nseg,noff)^) = ExeName) And (id = Int2fId);
End;
(*
* for TsrInstall messages
*)
Procedure MsgHalt( msg : String );
Begin
WriteLn(msg);
Halt;
End;
Begin
Int2fId := TsrId;
GetExeName;
TsrLoaded := TsrInstalled;
If Swap(DosVersion) < $030a Then
MsgHalt('Dos version 3.10 or higher required');
If ParamCount > 0 Then Begin
CmdLn := ParamStr(1);
For i := 1 To 2 Do
CmdLn[i] := UpCase(CmdLn[i]);
If TsrLoaded Then Begin
If (CmdLn = '/U') Then Begin
(* TSR removal, call int 2f to get the vectors and segment *)
Asm
mov ah,Int2fId
mov al,1
int 2fh
mov word ptr [NewInts],bx
mov word ptr [NewInts+2],es
mov word ptr [OldInts],di
mov word ptr [OldInts+2],es
mov ProgSegs,dx
End;
(*
* Are these vectors still ours ?
*)
For i := 1 To IntCnt Do Begin
GetIntVec( IntNum[i], p );
If Ptr(Seg(NewInts^),NewInts^[i]) <> p Then
MsgHalt(ExeName+'not loaded last in interrupt chain - not removed!');
End;
(*
* restore old vectors
*)
For i := 1 To IntCnt Do
SetIntVec( IntNum[i], OldInts^[i] );
(*
* free up memory
*)
FreeMemBlock(ProgSegs);
If Error <> 0 Then
MsgHalt('Dos error: could not deallocate memory.')
Else
MsgHalt(ExeName+' removed from memory.');
End (* CmdLn = '/U' *) Else Begin (* CmdLn <> '/U' *)
(*
* At this point all commandline parameters <> '/U'
* can be handled for the loaded Tsr
*)
If Addr(Check) <> Nil Then
Check;
End (* CmdLn <> '/U' *);
Halt;
End (* Loaded *) Else Begin (* Not Loaded *)
If (CmdLn = '/U') Then
MsgHalt(ExeName+' is not resident.')
Else Begin (* CmdLn <> '/U' *)
(*
* At this point all commandline parameters <> '/U'
* can be handled for the Tsr to be installed.
*)
If Addr(Check) <> Nil Then
Check;
End (* CmdLn <> '/U' *);
End (* Not Loaded *);
End (* ParamCount > 0 *);
If TsrLoaded Then
MsgHalt(ExeName+' is already resident'^m^j'Hotkey : '+KeyName);
(*
* here is where the installation starts
*)
TurboSS := SSeg;
TurboSP := SPtr - $200;
If Addr(Proc) <> Nil Then
UserProc := Proc
Else
UserProc := UserDummy;
If Addr(Server) <> Nil Then
User2fServer := Server
Else
User2fServer := UserDummy;
If Not GetDosVars Then
MsgHalt('Dos variables not located.');
Setup( KeyCode );
(*
* save original vectors and set new ones
*)
For i := 1 To IntCnt Do Begin
GetIntVec( Intnum[i], OldInts^[i] );
SetIntVec( IntNum[i], Ptr(CSeg,NewInts^[i]) );
End;
(*
* get Turbo error handler
*)
GetIntVec( $24, TurboInt24 );
WriteLn(ExeName+' is resident.'^m^j'Hotkey : '+KeyName);
(*
* calculate programsize and set it
*)
ProgSegs := Seg(HeapPtr^)+1-PrefixSeg;
(*
* Free up environment
*)
FreeMemBlock(MemW[PrefixSeg:$2c]);
(*
* tsrinstall will no longer be used, so place DOSBuffer at
* position of this routine (saves space)
*)
DOSBuffer := @TsrInstall;
SwapVectors;
(*
* stay resident
*)
Asm
mov ax,3100h (* keep *)
mov dx,[ProgSegs]
int 21h
End;
End;
(*
* UserDummy can be used if no 'remote' control is required
*)
Procedure UserDummy; Assembler;
Asm
End;
End.